;作者: Colin Cai
;E-mail: Colin_Cai_Jin@163.com

(require racket/draw)
;超蓝(本机器人的编写者)的做法......好吧，这样也好，我就把它封装到class里
(define chess-colin-cai%
  (class object%
    (super-new)
(field 
  (~all-chess-states (make-hash)))

(define/public (chess-version)
  (displayln "V2.0"))

(define/public (watch-states . port)
  (apply displayln ~all-chess-states port))

(define (~make-chess-board x-max y-max)
  (let ((b (make-vector y-max 0)))
    (for-each
      (lambda (n)
        (vector-set! b n (make-vector x-max 0)))
      (range y-max))
    b))

(define (~make-weiqi size)
    `((board . ,(~make-chess-board size size))
      (step . 1)
      (b-dead . 0)
      (w-dead . 0)
      (type . weiqi)
      (manual . ())))

(define (~search-chess qq)
  (let ((keys (hash-keys ~all-chess-states)))
    (let it ((keys keys))
      (if (null? keys)
          #f
          (if (or (eq? qq (caar keys)) (eq? qq (cdar keys)))
              (cons (car keys) (hash-ref ~all-chess-states (car keys)))
              (it (cdr keys)))))))

(define/public (close-game)
  (let ((s (~search-chess __sender-id)))
    (when s
      (let ((handicap (assq 'handicap (cdr s))))
	(when handicap
	  (displayln (cdr handicap))))
      (let ((manual (assq 'manual (cdr s))))
	(when manual
	  (displayln (reverse (cdr manual)))))
      (hash-remove! ~all-chess-states (car s)))
    (displayln "OK!")))

;(new-weiqi 1234567)
;(new-weiqi '(1234567 2345678))
;(new-weiqi '(1234567 2345678 19))
;(new-weiqi '(1234567 2345678 19) '((d 3) (d 15) (p 3) (p 15)))
(define/public (new-weiqi . all-args)
  (define (trans-stone lst)
    (define (sym->num s)
      (let ((c (string-ref (symbol->string s) 0)))
	(cond
	  ((char<=? #\a c #\z) (- (char->integer c) (char->integer #\a)))
	  ((char<=? #\A c #\Z) (- (char->integer c) (char->integer #\A)))
	  (else -1))))
    (define (trans-coor a b)
      (cond
	((and (number? (first lst)) (number? (second lst)))
	 lst)
	((and (symbol? (first lst)) (number? (second lst)))
	 (list (sym->num (first lst)) (second lst)))
	((and (number? (first lst)) (symbol? (second lst)))
	 (list (sym->num (second lst)) (first lst)))
	(else '(-1 -1))))
    (cond
      ((= (length lst) 3)
	(append (apply trans-coor (take lst 2))
		(list
		  (cond
		    ((number? (third lst)) (third lst))
		    ((eq? (third lst) 'b) 1)
		    ((eq? (third lst) 'B) 1)
		    (else 2)))))
      (else (trans-stone `(,@lst 1)))))
  (define args (filter (compose not (curry eq? 'noshow)) all-args))
  (if (null? args)
      (display "This function is to create a new game of weiqi.\n(new-weiqi qq) : Create a new game. You are the black and qq is the white.\n(new-weiqi (list qq qq2)) : Create a new game. qq is the black and qq2 is the white. One of qq/qq2 must be you.\n (new-weiqi (list qq qq2 size)) : Create a new game whith the board size of 'size'. qq is the black and qq2 is the white. One of qq/qq2 must be you.\nAnd, you can add another argument for handicap\nThis argument is a list of w/b(means who begin to put stone) and coordinates(and, you can append a color b/w in the end of each coordinate)\nFor example :\n (new-weiqi '(10000 10001 19) '(b (d 3) (p 15) (d 15 2) (p 3 2)))\n")
      (let* ((arg (car args))
             (black (if (number? arg) __sender-id (first arg)))
             (white (if (number? arg) arg (second arg)))
             (size (if (and (list? arg) (>= (length arg) 3)) (list-ref arg 2) 19))
             (black-pair (~search-chess black))
             (white-pair (~search-chess white))
             (!= (compose not eq?)))
        (cond
          ((and (!= __sender-id black) (!= __sender-id white))
           (displayln "You have no permission to create"))
          ((= black white)
           (displayln "You can not make a game against yourself"))
          ((or black-pair white-pair)
           (for-each
             (lambda (p)
               (and
                 (cdr p)
                 (printf "~a, there's your game. You should call (close-game) at first\n" (car p))))
             (list (cons black black-pair) (cons white white-pair))))
          (else
            (let ((b (~make-weiqi size)))
	      (if (not (null? (cdr args)))
		  (let ((color-begin (caadr args))
			(handicap-stones (cdadr args))
			(board (cdr (assq 'board b))))
		    (for-each
		      (lambda (xyc)
			(vector-set! (vector-ref board (second xyc)) (first xyc) (third xyc)))
		      (map trans-stone handicap-stones))
		    (hash-set!
		      ~all-chess-states
		      (cons black white)
		      (foldl
			(lambda (x r) (~set-alist-value r (car x) (cdr x)))
			b
			`((step . ,(if (memq color-begin '(B b)) 1 2)) (handicap . ,(cadr args))))))
		  (hash-set! ~all-chess-states (cons black white) b))
	    (when (not (memq 'noshow all-args))
	      (printf "[mirai:at:~a] Come on, baby, your game here\n"
		      (car (filter (lambda (x) (not (= __sender-id x))) `(,black ,white))))
	      (~show-weiqi -1 -1))))))))

(define (~make-wuziqi size . is_standard)
    `((board . ,(~make-chess-board size size))
      (step . 1)
      (type . wuziqi)
      (arg . ,(if (or (null? is_standard) (not (car is_standard))) 'normal 'standard))
      (manual . ())))

(define/public (new-wuziqi . all-args)
  (define args (filter (compose not (curry eq? 'noshow)) all-args))
  (if (null? args)
      (display "")
      (let* ((arg (car args))
             (black (if (number? arg) __sender-id (first arg)))
             (white (if (number? arg) arg (second arg)))
             (size (if (and (list? arg) (>= (length arg) 3)) (list-ref arg 2) 15))
             (black-pair (~search-chess black))
             (white-pair (~search-chess white))
             (!= (compose not eq?)))
        (cond
          ((and (!= __sender-id black) (!= __sender-id white))
           (displayln "You have no permission to create"))
          ((= black white)
           (displayln "You can not make a game against yourself"))
          ((or black-pair white-pair)
           (for-each
             (lambda (p)
               (and
                 (cdr p)
                 (printf "~a, there's your game. You should call (close-game) at first\n" (car p))))
             (list (cons black black-pair) (cons white white-pair))))
	  (else
	    (let ((b (~make-wuziqi size)))
	      (hash-set! ~all-chess-states (cons black white) b)
	      (when (not (memq 'noshow all-args))
		(printf "[mirai:at:~a] Come on, baby, your game here\n"
			(car (filter (lambda (x) (not (= __sender-id x))) `(,black ,white))))
		(~print-board (cdr (assq 'board b))))))))))

;(define (~print-board board x y)
;  (define (print-line v)
;    (do ((x 0 (+ x 1)))
;      ((>= x (vector-length v)))
;      (display (vector-ref v x)))
;    (newline))
;  (do ((y 0 (+ y 1)))
;    ((>= y (vector-length board)))
;    (print-line (vector-ref board y)))
;  (newline))

;WRITE_PIC
;(define seq 100)
(define (~print-board board . xys)
  (let ((y-max (vector-length board))
        (x-max (vector-length (vector-ref board 0))))
    (let* ((width (+ 40 (* x-max 20)))
           (height (+ 40 (* y-max 20)))
           (bm (make-object bitmap% width height))
           (dc (send bm make-dc))
           (dc2 (send bm make-dc))
           (color-board (make-object color% 215 255 124))
           ;(color-board (make-object color% 162 109 62))
           (color-white (make-object color% 255 255 255))
           ;(color-white (make-object color% 220 220 220))
           (color-black (make-object color% 0 0 0))
           (color-line (make-object color% 80 80 80))
           (color-red (make-object color% 255 0 0)))
      (send dc set-pen
            (send the-pen-list find-or-create-pen
                  color-board 1 'solid 'round))
      (for-each
        (lambda (h) (send dc draw-line 0 h width h))
        (range height))

      (for-each
        (lambda (y) (send dc draw-text (number->string y) 2 (+ 20 (* y 20)))
          (send dc draw-text (number->string y) (+ 20 (* x-max 20)) (+ 20 (* y 20))))
        (range y-max))

      (for-each
        (lambda (x) (send dc draw-text (make-string 1 (integer->char (+ (char->integer #\A) x))) (+ 25 (* x 20)) 2)
          (send dc draw-text (make-string 1 (integer->char (+ (char->integer #\A) x))) (+ 25 (* x 20)) (+ 20 (* y-max 20))))
        (range x-max))
      (send dc set-pen
            (send the-pen-list find-or-create-pen
                  color-line 1 'solid 'round))
      (for-each
        (lambda (y) (send dc draw-line 30 (+ 30 (* y 20)) (- width 30) (+ 30 (* y 20))))
        (range y-max))
      (for-each
        (lambda (x) (send dc draw-line (+ 30 (* x 20)) 30  (+ 30 (* x 20)) (- width 30)))
        (range y-max))
      (send dc set-pen
            (send the-pen-list find-or-create-pen
                  color-line 5 'solid 'round))
      (for-each
        (lambda (xy)
          (send dc draw-point (+ 30 (* (first xy) 20)) (+ 30 (* (second xy) 20))))
        (if (and (> x-max 12) (> y-max 12))
        (cartesian-product `(3 ,(quotient x-max 2) ,(- x-max 4)) `(3 ,(quotient y-max 2) ,(- y-max 4)))
        `((,(quotient x-max 2) ,(quotient y-max 2)))))
      (send dc set-pen
            (send the-pen-list find-or-create-pen
                  color-black 18 'solid 'round))
      (send dc2 set-pen
            (send the-pen-list find-or-create-pen
                  color-white 18 'solid 'round))
      (for-each
        (lambda (xy)
          (let* ((x (first xy))
                 (y (second xy))
                 (c (vector-ref (vector-ref board y) x)))
            (case c
              ((1) (send dc draw-point (+ 30 (* x 20)) (+ 30 (* y 20))))
              ((2) (send dc2 draw-point (+ 30 (* x 20)) (+ 30 (* y 20)))))))
        (cartesian-product (range x-max) (range y-max)))

      (for-each
	(lambda (xy)
	  (let ((x (first xy))
		(y (second xy)))
	    (when (and (< -1 x x-max) (< -1 y y-max))
	      (send dc set-pen
		    (send the-pen-list find-or-create-pen
			  color-red 3 'solid 'round))
	      (send dc draw-point (+ 30 (* x 20)) (+ 30 (* y 20))))))
	(map
	  (lambda (indexes)
	    (map (curry list-ref xys) indexes))
	  (map (lambda (x) (list (* 2 x) (+ 1 (* 2 x)))) (range (quotient (length xys) 2)))))
      ;WRITE_PIC
      ;(send bm save-file (string-append (number->string seq) ".bmp") 'bmp )
      ;(set! seq (+ 1 seq))
      bm)))

(define (~show-weiqi x y)
  (let ((weiqi-state (cdr (~search-chess __sender-id))))
  (printf "black dead : ~a white dead : ~a\n"
          (cdr (assq 'b-dead weiqi-state))
          (cdr (assq 'w-dead weiqi-state)))
  (~print-board (cdr (assq 'board weiqi-state)) x y)))

(define (~delete-alist-key alist key)
  (if (null? alist)
      '()
      (if (eq? key (caar alist))
          (cdr alist)
          (cons (car alist) (~delete-alist-key (cdr alist) key)))))

(define (~set-alist-value alist key value)
  (if (null? alist)
      (list (cons key value))
      (if (eq? key (caar alist))
          (cons (cons key value) (cdr alist))
          (cons (car alist) (~set-alist-value (cdr alist) key value)))))

(define/public (~chess-turn color x y)
  (let ((state-pair (~search-chess __sender-id)))
    (if state-pair
        (if (or (and (= color 1) (eq? __sender-id (caar state-pair)))
                (and (= color 2) (eq? __sender-id (cdar state-pair))))
        (let ((state (cdr state-pair)))
          (case (cdr (assq 'type state))
            ((weiqi) (~weiqi-turn color x y state))
            ((wuziqi) (~wuziqi-turn color x y state))
	    ))
        (printf "ERROR! You are the ~a\n" (if (eq? __sender-id (caar state-pair)) "black" "white")))
        (displayln "There's no chess game related to you"))))

(define (connect-graph-flags connect? queue board flags)
  (define y-max (vector-length board))
  (define x-max (vector-length (vector-ref board 0)))
  (define (get board x y) (vector-ref (vector-ref board y) x))
  (define (in x y) (and (< -1 x x-max) (< -1 y y-max)))
  (define (set-flag xy)
    (vector-set! (vector-ref flags (second xy)) (first xy) 1))
  (call/cc
    (lambda (return)
      (for-each
	(lambda (xy)
	  (if (= 1 (apply get flags xy))
	      (return '())
	      (set-flag xy)))
	queue)
      (let it ((r '())
	       (queue queue))
	(if (null? queue)
	    r
	    (let ((neighbour-stones
		    (filter
		      (lambda (xy)
			(and (apply in xy)
			     (= 0 (apply get flags xy))
			     (connect? (apply get board xy))))
		      (map (lambda (delta) (map + delta (car queue))) '((-1 0) (1 0) (0 -1) (0 1))))))
	      (for-each set-flag neighbour-stones)
	      (it (cons (car queue) r) (append (cdr queue) neighbour-stones))))))))

(define (~~weiqi-turn color x y weiqi-state)
  (define step (cdr (assq 'step weiqi-state)))
  (define board (cdr (assq 'board weiqi-state)))
  (define y-max (vector-length board))
  (define x-max (vector-length (vector-ref board 0)))
  (define (get board x y) (vector-ref (vector-ref board y) x))
  (define (set board x y r) (vector-set! (vector-ref board y) x r))
  (define (in x y) (and (< -1 x x-max) (< -1 y y-max)))
  (define (have-qi? connected-coordinates)
    (call/cc
      (lambda (k)
	(if (null? connected-coordinates)
	    #f
	    (begin
	      (for-each
		(lambda (delta)
		  (let ((xy (map + delta (car connected-coordinates))))
		    (when (and (apply in xy) (= 0 (apply get board xy)))
		      (k #t))))
		'((-1 0) (1 0) (0 -1) (0 1)))
	      (have-qi? (cdr connected-coordinates)))))))
  (cond
    ((not (zero? (get board x y))) (displayln "ERROR!There's a stone"))
    (else
      (set board x y color)
      (let* ((flags (~make-chess-board x-max y-max))
	     (qi+connect-graph
	       (lambda (xy)
		 (let* ((color (apply get board xy))
			(stones (connect-graph-flags (lambda (c) (= c color)) `(,xy) board flags)))
		 (cons (have-qi? stones) stones))))
	     (opponent-color (car (remove color '(1 2))))
             (mine (qi+connect-graph `(,x ,y)))
	     (another (apply append
			     (map
			       cdr
			       (filter
				 (compose not car)
				 (map
				   (lambda (delta)
				     (let ((other-xy (map + `(,x ,y) delta)))
				       (if (and (apply in other-xy) (= opponent-color (apply get board other-xy)))
					   (qi+connect-graph other-xy)
					   '(#t))))
				   '((1 0) (-1 0) (0 1) (0 -1)))))))
             (clear (lambda () (for-each (lambda (xy) (set board (first xy) (second xy) 0)) another)
                      (set! weiqi-state (~delete-alist-key weiqi-state 'kofight))
                      (set! weiqi-state (~set-alist-value weiqi-state 'step (+ 1 (cdr (assq 'step weiqi-state)))))
                      (let ((c (if (= 1 color) 'w-dead 'b-dead)))
			(set! weiqi-state (~set-alist-value weiqi-state c (+ (length another) (cdr (assq c weiqi-state))))))
		      (set! weiqi-state (~set-alist-value weiqi-state 'manual (cons (list (if (= color 1) 'B 'W) x y) (cdr (assq 'manual weiqi-state))))))))
        (cond
          ((car mine) (clear))
          ((null? another) (set board x y 0) (set! x -1))
          ((or (> (length (cdr mine)) 1) (> (length another) 1)) (clear))
          ((let ((kofight (assq 'kofight weiqi-state)))
	     (and kofight (equal? `(,x ,y) (cdr kofight))))
	   (set board x y 0) (set! x -1) (displayln "ERROR!Kofight"))
	  (else
            (clear)
            (set! weiqi-state (cons (cons 'kofight (car another)) weiqi-state)))))))
  (hash-set! ~all-chess-states (car (~search-chess __sender-id)) weiqi-state)
  )

(define (~weiqi-turn color x y weiqi-state . other-arg)
  (define step (cdr (assq 'step weiqi-state)))
  (if (odd? (+ step color))
      (displayln "ERROR!Not your turn")
      (begin
	(~~weiqi-turn color x y weiqi-state)
	(when (or (null? other-arg) (not (eq? (car other-arg) 'noshow)))
	  (~show-weiqi x y)))))

(define/public (~clear-stones x y)
  (define (clear-stones-board board x y)
    (define y-max (vector-length board))
    (define x-max (vector-length (vector-ref board 0)))
    (define (get board x y) (vector-ref (vector-ref board y) x))
    (define (set board x y r) (vector-set! (vector-ref board y) x r))
    (define (in x y) (and (< -1 x x-max) (< -1 y y-max)))
    (cond
      ((not (in x y)) (displayln "ERROR! Out of range"))
      ((= 0 (get board x y)) (displayln "You should choose a stone"))
      (else
	(let* ((color (get board x y))
	       (flags (~make-chess-board x-max y-max))
	       (all-stones-to-clear (connect-graph-flags (lambda (c) (or (= c 0) (= c color))) `((,x ,y)) board flags)))
	  (for-each
	    (lambda (xy) (set board (first xy) (second xy) 0))
	    all-stones-to-clear))
	(~print-board board -1 -1))))
  (define (get board x y) (vector-ref (vector-ref board y) x))
  (define (set board x y r) (vector-set! (vector-ref board y) x r))
  (let ((s (~search-chess __sender-id)))
    (if (null? s)
	(displayln "There's no chess game related to you")
	(let* ((alist (cdr s))
	       (board-pair (assq 'clear alist)))
	  (if board-pair
	      (clear-stones-board (cdr board-pair) x y)
	      (let* ((board (cdr (assq 'board alist)))
		     (y-max (vector-length board))
		     (x-max (vector-length (vector-ref board 0)))
		     (new-board (~make-chess-board x-max y-max)))
		(hash-set! ~all-chess-states (car s) (~set-alist-value alist 'clear new-board))
		(for-each
		  (lambda (xy)
		    (set new-board (first xy) (second xy) (apply get board xy)))
		  (cartesian-product (range x-max) (range y-max)))
		(clear-stones-board new-board x y)))))))

(define/public (reclear-stones)
  (let ((s (~search-chess __sender-id)))
    (if (null? s)
	(displayln "There's no chess game related to you")
	(begin
	  (hash-set! ~all-chess-states (car s) (~delete-alist-key (cdr s) 'clear))
	  (displayln "OK")
	  (~show-weiqi -1 -1)))))

(define (~calculate-weiqi-result board)
  (define y-max (vector-length board))
  (define x-max (vector-length (vector-ref board 0)))
  (define flags (~make-chess-board x-max y-max))
  (define (in x y) (and (< -1 x x-max) (< -1 y y-max)))
  (define (get board x y) (vector-ref (vector-ref board y) x))
  (define (set board x y r) (vector-set! (vector-ref board y) x r))
  (define (set-color empty-pos-list);use call/cc
    (call/cc
      (lambda (return)
	(let ((color 0))
	  (for-each
	    (lambda (xy)
	      (for-each
		(lambda (delta)
		  (let ((xy (map + delta xy)))
		    (when (apply in xy)
		      (let ((c (apply get board xy)))
			(when (not (zero? c))
			  (set! color (bitwise-ior c color))
			  (when (= color 3)
			    (return 3)))))))
		'((-1 0) (1 0) (0 -1) (0 1))))
	    empty-pos-list)
	  color))))
  (for-each
    (lambda (xy)
      (when (and (= 0 (apply get flags xy)) (= 0 (apply get board xy)))
	(let* ((empty-block (connect-graph-flags zero? `(,xy) board flags))
	       (dye-color (set-color empty-block)))
	  (for-each
	  (lambda (xy) (set board (first xy) (second xy) dye-color))
	    empty-block))))
    (cartesian-product (range x-max) (range y-max)))
  (let ((black-cnt 0)
	(white-cnt 0)
	(empty-cnt 0))
    (for-each
      (lambda (xy)
	(case (apply get board xy)
	  ((1) (set! black-cnt (+ 1 black-cnt)))
	  ((2) (set! white-cnt (+ 1 white-cnt)))
	  ((3) (set! empty-cnt (+ 1 empty-cnt)))))
      (cartesian-product (range x-max) (range y-max)))
  (printf "black : ~a~a white : ~a~a\n"
	  (+ black-cnt (quotient empty-cnt 2))
	  (if (odd? empty-cnt) "+1/2" "")
	  (+ white-cnt (quotient empty-cnt 2))
	  (if (odd? empty-cnt) "+1/2" ""))))

(define/public (calculate-weiqi)
  (let ((p (~search-chess __sender-id)))
    (if p
	(if (eq? 'weiqi (cdr (assq 'type (cdr p))))
	    (if (assq 'clear (cdr p))
		(~calculate-weiqi-result (cdr (assq 'clear (cdr p))))
		(~calculate-weiqi-result (cdr (assq 'board (cdr p)))))
	    (displayln "It's not weiqi"))
	(displayln "There's no chess game related to you"))))


(define/public (withdraw)
  (let ((s (~search-chess __sender-id)))
    (if s
	(let* ((chess-state (cdr s))
	       (board-size (vector-length (cdr (assq 'board chess-state))))
	       (manual (cdr (assq 'manual chess-state)))
	       (handicap ((lambda (x) (and x (cdr x))) (assq 'handicap chess-state))))
	  (if (null? manual)
	      (displayln "OK!")
	      (begin
		(hash-remove! ~all-chess-states (car s))
	  (case (cdr (assq 'type chess-state))
	    ((weiqi)
	     (let ((base `(,(caar s) ,(cdar s) ,board-size)))
	       (if handicap
		   (new-weiqi base handicap 'noshow)
		   (new-weiqi base 'noshow))
	       (for-each
		 (lambda (step)
		   (~~weiqi-turn (if (eq? 'B (first step)) 1 2) (second step) (third step) (hash-ref ~all-chess-states (car s))))
		 (reverse (cdr manual))))
	     (apply ~show-weiqi (cdr (second manual))))
	    ((wuziqi)
	     (let ((base `(,(caar s) ,(cdar s) ,board-size)))
	       (new-wuziqi base 'noshow)
	       (for-each
		 (lambda (step)
		   (~wuziqi-turn (if (eq? 'B (first step)) 1 2) (second step) (third step) (hash-ref ~all-chess-states (car s))))
		 (reverse (cdr manual))))
	     )
	    ))))
	(displayln "There's no chess game related to you"))))

(define (wuziqi-normal color x y state)
  (define step (cdr (assq 'step state)))
  (define board (cdr (assq 'board state)))
  (define y-max (vector-length board))
  (define x-max (vector-length (vector-ref board 0)))
  (define (get board x y) (vector-ref (vector-ref board y) x))
  (define (set board x y r) (vector-set! (vector-ref board y) x r))
  (define (in x y) (and (< -1 x x-max) (< -1 y y-max)))
  (cond
    ((not (zero? (get board x y))) (begin (displayln "ERROR!There's a stone") #f))
    (else
      (set board x y color)
      (set! state (~set-alist-value state 'step (+ 1 (cdr (assq 'step state)))))
      (set! state (~set-alist-value state 'manual (cons (list (if (= color 1) 'B 'W) x y) (cdr (assq 'manual state)))))
      (hash-set! ~all-chess-states (car (~search-chess __sender-id)) state)
      (call/cc
	(lambda (k)
	  (for-each
	    (lambda (s)
	      (let* ((start-sub (first s))
		     (step (second s))
		     (start-point (map - `(,x ,y) (map (lambda (n) (* n start-sub)) step)))
		     (end-point (map + start-point (map (lambda (n) (* n 4)) step))))
		(when (and (apply in start-point) (apply in end-point))
		  (when
		    (equal?
		      (make-list 5 color)
		      (map
			(lambda (n)
			  (apply get board (map + start-point (map (lambda (m) (* m n)) step))))
			(range 5)))
		    (k #t)))))
	    (cartesian-product (range 5) '((1 0) (0 1) (1 1) (1 -1))))
	  #f)))))

(define (wuziqi-standard color x y state)
  ;TODO
  #f
  )

(define (~wuziqi-turn color x y state . other-arg)
  (define step (cdr (assq 'step state)))
  (define type (cdr (assq 'arg state)))
  (if (odd? (+ step color))
      (displayln "ERROR!Not your turn")
      (let* ((result
	       (case type
		 ((normal) (wuziqi-normal color x y state))
		 ((standard) (wuziqi-standard color x y state))))
	     (board (cdr (assq 'board (cdr (~search-chess __sender-id))))))
	(when (eq? result #t)
	  (close-game)
	  (printf "[mirai:at:~a], you're the winner!\n" __sender-id))
	(when (or (null? other-arg) (not (eq? (car other-arg) 'noshow)))
	  (~print-board board x y)))))

))

(define chess-colin-cai (new chess-colin-cai%))
(define (chess-version) (send chess-colin-cai chess-version))
(define (watch-states . port) (send/apply chess-colin-cai watch-states port))
(define (close-game) (send chess-colin-cai close-game))

(define (new-weiqi . args) (send/apply chess-colin-cai new-weiqi args))
(define (~chess-turn color x y) (send chess-colin-cai ~chess-turn color x y))
(define (~clear-stones x y) (send chess-colin-cai ~clear-stones x y))
(define (reclear-stones) (send chess-colin-cai reclear-stones))
(define (calculate-weiqi) (send chess-colin-cai calculate-weiqi))
(define (withdraw) (send chess-colin-cai withdraw))

(define (new-wuziqi . args) (send/apply chess-colin-cai new-wuziqi args))

(define-syntax (~chess-play-xy x)
  (define (sym->num s)
    (let ((c (string-ref (symbol->string s) 0)))
      (cond
        ((char<=? #\a c #\z) (- (char->integer c) (char->integer #\a)))
        ((char<=? #\A c #\Z) (- (char->integer c) (char->integer #\A)))
        (else -1))))
  (define (split-coor-to-symbols s)
    (let ((first-char (string-ref s 0)))
      (if (char<=? #\0 (string-ref s 0) #\9)
	  (let ((len (string-length s)))
	    (cons
	      (string->number (substring s 0 (- len 1)))
	      (string->symbol (substring s (- len 1)))))
	  (cons
	    (string->symbol (substring s 0 1))
	    (string->number (substring s 1))))))
  (syntax-case x ()
	       ((k ~c ~s)
		(let* ((c (syntax->datum #'~c))
		      (s (syntax->datum #'~s))
		      (coor-pair (split-coor-to-symbols (symbol->string s)))
		      (a (car coor-pair))
		      (b (cdr coor-pair)))
		  (datum->syntax #'k `(~chess-play-xy ,c ,a ,b))))
	       ((k ~c ~a ~b)
                (let ((a (syntax->datum #'~a))
                      (b (syntax->datum #'~b))
                      (c (syntax->datum #'~c)))
                  (if (and (number? a) (number? b))
                      #'(~chess-turn ~c ~a ~b)
                      (if (symbol? a)
                          (datum->syntax #'k `(~chess-turn ,c ,(sym->num a) ,b))
                          (datum->syntax #'k `(~chess-turn ,c ,(sym->num b) ,a))))))))

(define-syntax black
  (syntax-rules ()
    ((_ a ...) (~chess-play-xy 1 a ...))))

(define-syntax white
  (syntax-rules ()
    ((_ a ...) (~chess-play-xy 2 a ...))))

(define-syntax (clear-stones x)
  (define (sym->num s)
    (let ((c (string-ref (symbol->string s) 0)))
      (cond
        ((char<=? #\a c #\z) (- (char->integer c) (char->integer #\a)))
        ((char<=? #\A c #\Z) (- (char->integer c) (char->integer #\A)))
        (else -1))))
  (define (split-coor-to-symbols s)
    (let ((first-char (string-ref s 0)))
      (if (char<=? #\0 (string-ref s 0) #\9)
	  (let ((len (string-length s)))
	    (cons
	      (string->number (substring s 0 (- len 1)))
	      (string->symbol (substring s (- len 1)))))
	  (cons
	    (string->symbol (substring s 0 1))
	    (string->number (substring s 1))))))
  (syntax-case x ()
	       ((k ~s)
		(let* ((s (syntax->datum #'~s))
		      (coor-pair (split-coor-to-symbols (symbol->string s)))
		      (a (car coor-pair))
		      (b (cdr coor-pair)))
		  (datum->syntax #'k `(clear-stones ,a ,b))))
	       ((k ~a ~b)
                (let ((a (syntax->datum #'~a))
                      (b (syntax->datum #'~b)))
                  (if (and (number? a) (number? b))
                      #'(~clear-stones ~a ~b)
                      (if (symbol? a)
                          (datum->syntax #'k `(~clear-stones ,(sym->num a) ,b))
                          (datum->syntax #'k `(~clear-stones ,(sym->num b) ,a))))))))

;这个宏是可以生成一堆宏,比如(bn8)和(b8n)和(black n 8)同一作用
;但是生成的宏的数量很多,4*38*19*2=5776
(define-syntax (all-make-play-stones x)
  (define (range n)
    (let it ((r '())
	     (n (- n 1)))
      (if (< n 0)
	  r
	  (it (cons n r) (- n 1)))))
  (define (cartesian-product . s)
    (define (append-all s1 s2)
      (apply append
	     (map
	(lambda (x) (map (lambda (y) (cons y x)) s1))
	s2)))
    (cond
      ((null? s) '())
      ((null? (cdr s)) (map list (car s)))
      (else (append-all (car s) (apply cartesian-product (cdr s))))))
  (syntax-case x ()
	((k)
	  (datum->syntax #'k
	     (cons 'begin
	       (apply append
		 (map
		  (lambda (x)
		    (map
		      (lambda (macro-name)
			`(define-syntax
			   ,(string->symbol macro-name)
			   (syntax-rules ()
			     ((_)
			      (,(case (car x) ((w W) 'white) (else 'black))
				,(string->symbol (make-string 1 (integer->char (cadr x))))
				,(caddr x))))))
		      (map
			(lambda (seq)
			  (apply string-append
				 (map
				   (lambda (n)
				     (list-ref
				       `(,(symbol->string (car x))
					  ,(make-string 1 (integer->char (cadr x)))
					  ,(number->string (caddr x)))
				       n))
				   seq)))
			'((0 1 2) (0 2 1)))))
		   (cartesian-product
		     '(w W B b)
		     (apply append
		       (map
			 (lambda (x)
			   (map (lambda (c) (+ (char->integer c) x)) '(#\a #\A)))
			 (range 19)))
		     (range 19)))))))))
